home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Tools / Turbo Pascal V7 / SOURCE.ZIP / WINDOS.PAS < prev   
Pascal/Delphi Source File  |  1992-11-03  |  27KB  |  1,347 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Runtime Library                    }
  5. {       Windows DOS Interface Unit                      }
  6. {                                                       }
  7. {       Copyright (c) 1991,92 Borland International     }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit WinDos;
  12.  
  13. {$O+,S-,W-}
  14.  
  15. interface
  16.  
  17. { Flags bit masks }
  18.  
  19. const
  20.   fCarry     = $0001;
  21.   fParity    = $0004;
  22.   fAuxiliary = $0010;
  23.   fZero      = $0040;
  24.   fSign      = $0080;
  25.   fOverflow  = $0800;
  26.  
  27. { File mode magic numbers }
  28.  
  29. const
  30.   fmClosed = $D7B0;
  31.   fmInput  = $D7B1;
  32.   fmOutput = $D7B2;
  33.   fmInOut  = $D7B3;
  34.  
  35. { File attribute constants }
  36.  
  37. const
  38.   faReadOnly  = $01;
  39.   faHidden    = $02;
  40.   faSysFile   = $04;
  41.   faVolumeID  = $08;
  42.   faDirectory = $10;
  43.   faArchive   = $20;
  44.   faAnyFile   = $3F;
  45.  
  46. { Maximum file name component string lengths }
  47.  
  48. const
  49.   fsPathName  = 79;
  50.   fsDirectory = 67;
  51.   fsFileName  = 8;
  52.   fsExtension = 4;
  53.  
  54. { FileSplit return flags }
  55.  
  56. const
  57.   fcExtension = $0001;
  58.   fcFileName  = $0002;
  59.   fcDirectory = $0004;
  60.   fcWildcards = $0008;
  61.  
  62. { Registers record used by Intr and MsDos }
  63.  
  64. type
  65.   TRegisters = record
  66.     case Integer of
  67.       0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);
  68.       1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
  69.   end;
  70.  
  71. { Typed-file and untyped-file record }
  72.  
  73. type
  74.   TFileRec = record
  75.     Handle: Word;
  76.     Mode: Word;
  77.     RecSize: Word;
  78.     Private: array[1..26] of Byte;
  79.     UserData: array[1..16] of Byte;
  80.     Name: array[0..79] of Char;
  81.   end;
  82.  
  83. { Textfile record }
  84.  
  85. type
  86.   PTextBuf = ^TTextBuf;
  87.   TTextBuf = array[0..127] of Char;
  88.   TTextRec = record
  89.     Handle: Word;
  90.     Mode: Word;
  91.     BufSize: Word;
  92.     Private: Word;
  93.     BufPos: Word;
  94.     BufEnd: Word;
  95.     BufPtr: PTextBuf;
  96.     OpenFunc: Pointer;
  97.     InOutFunc: Pointer;
  98.     FlushFunc: Pointer;
  99.     CloseFunc: Pointer;
  100.     UserData: array[1..16] of Byte;
  101.     Name: array[0..79] of Char;
  102.     Buffer: TTextBuf;
  103.   end;
  104.  
  105. { Search record used by FindFirst and FindNext }
  106.  
  107. type
  108.   TSearchRec = record
  109.     Fill: array[1..21] of Byte;
  110.     Attr: Byte;
  111.     Time: Longint;
  112.     Size: Longint;
  113.     Name: array[0..12] of Char;
  114.   end;
  115.  
  116. { Date and time record used by PackTime and UnpackTime }
  117.  
  118. type
  119.   TDateTime = record
  120.     Year, Month, Day, Hour, Min, Sec: Word;
  121.   end;
  122.  
  123. { Error status variable }
  124.  
  125. var
  126.   DosError: Integer;
  127.  
  128. { DosVersion returns the DOS version number. The low byte of    }
  129. { the result is the major version number, and the high byte is  }
  130. { the minor version number. For example, DOS 3.20 returns 3 in  }
  131. { the low byte, and 20 in the high byte.                        }
  132.  
  133. function DosVersion: Word;
  134.  
  135. { Intr executes a specified software interrupt with a specified }
  136. { TRegisters package. NOTE: To avoid general protection faults  }
  137. { when running in protected mode, always make sure to           }
  138. { initialize the DS and ES fields of the TRegisters record with }
  139. { valid selector values, or set the fields to zero.             }
  140.  
  141. procedure Intr(IntNo: Byte; var Regs: TRegisters);
  142.  
  143. { MsDos invokes the DOS function call handler with a specified  }
  144. { TRegisters package.                                           }
  145.  
  146. procedure MsDos(var Regs: TRegisters);
  147.  
  148. { GetDate returns the current date set in the operating system. }
  149. { Ranges of the values returned are: Year 1980-2099, Month      }
  150. { 1-12, Day 1-31 and DayOfWeek 0-6 (0 corresponds to Sunday).   }
  151.  
  152. procedure GetDate(var Year, Month, Day, DayOfWeek: Word);
  153.  
  154. { SetDate sets the current date in the operating system. Valid  }
  155. { parameter ranges are: Year 1980-2099, Month 1-12 and Day      }
  156. { 1-31. If the date is not valid, the function call is ignored. }
  157.  
  158. procedure SetDate(Year, Month, Day: Word);
  159.  
  160. { GetTime returns the current time set in the operating system. }
  161. { Ranges of the values returned are: Hour 0-23, Minute 0-59,    }
  162. { Second 0-59 and Sec100 (hundredths of seconds) 0-99.          }
  163.  
  164. procedure GetTime(var Hour, Minute, Second, Sec100: Word);
  165.  
  166. { SetTime sets the time in the operating system. Valid          }
  167. { parameter ranges are: Hour 0-23, Minute 0-59, Second 0-59 and }
  168. { Sec100 (hundredths of seconds) 0-99. If the time is not       }
  169. { valid, the function call is ignored.                          }
  170.  
  171. procedure SetTime(Hour, Minute, Second, Sec100: Word);
  172.  
  173. { GetCBreak returns the state of Ctrl-Break checking in DOS.    }
  174. { When off (False), DOS only checks for Ctrl-Break during I/O   }
  175. { to console, printer, or communication devices. When on        }
  176. { (True), checks are made at every system call.                 }
  177.  
  178. procedure GetCBreak(var Break: Boolean);
  179.  
  180. { SetCBreak sets the state of Ctrl-Break checking in DOS.       }
  181.  
  182. procedure SetCBreak(Break: Boolean);
  183.  
  184. { GetVerify returns the state of the verify flag in DOS. When   }
  185. { off (False), disk writes are not verified. When on (True),    }
  186. { all disk writes are verified to insure proper writing.        }
  187.  
  188. procedure GetVerify(var Verify: Boolean);
  189.  
  190. { SetVerify sets the state of the verify flag in DOS.           }
  191.  
  192. procedure SetVerify(Verify: Boolean);
  193.  
  194. { DiskFree returns the number of free bytes on the specified    }
  195. { drive number (0=Default,1=A,2=B,..). DiskFree returns -1 if   }
  196. { the drive number is invalid.                                  }
  197.  
  198. function DiskFree(Drive: Byte): Longint;
  199.  
  200. { DiskSize returns the size in bytes of the specified drive     }
  201. { number (0=Default,1=A,2=B,..). DiskSize returns -1 if the     }
  202. { drive number is invalid.                                      }
  203.  
  204. function DiskSize(Drive: Byte): Longint;
  205.  
  206. { GetFAttr returns the attributes of a file. F must be a file   }
  207. { variable (typed, untyped or textfile) which has been assigned }
  208. { a name. The attributes are examined by ANDing with the        }
  209. { attribute masks defined as constants above. Errors are        }
  210. { reported in DosError.                                         }
  211.  
  212. procedure GetFAttr(var F; var Attr: Word);
  213.  
  214. { SetFAttr sets the attributes of a file. F must be a file      }
  215. { variable (typed, untyped or textfile) which has been assigned }
  216. { a name. The attribute value is formed by adding (or ORing)    }
  217. { the appropriate attribute masks defined as constants above.   }
  218. { Errors are reported in DosError.                              }
  219.  
  220. procedure SetFAttr(var F; Attr: Word);
  221.  
  222. { GetFTime returns the date and time a file was last written.   }
  223. { F must be a file variable (typed, untyped or textfile) which  }
  224. { has been assigned and opened. The Time parameter may be       }
  225. { unpacked throgh a call to UnpackTime. Errors are reported in  }
  226. { DosError.                                                     }
  227.  
  228. procedure GetFTime(var F; var Time: Longint);
  229.  
  230. { SetFTime sets the date and time a file was last written.      }
  231. { F must be a file variable (typed, untyped or textfile) which  }
  232. { has been assigned and opened. The Time parameter may be       }
  233. { created through a call to PackTime. Errors are reported in    }
  234. { DosError.                                                     }
  235.  
  236. procedure SetFTime(var F; Time: Longint);
  237.  
  238. { FindFirst searches the specified (or current) directory for   }
  239. { the first entry that matches the specified filename and       }
  240. { attributes. The result is returned in the specified search    }
  241. { record. Errors (and no files found) are reported in DosError. }
  242.  
  243. procedure FindFirst(Path: PChar; Attr: Word; var F: TSearchRec);
  244.  
  245. { FindNext returs the next entry that matches the name and      }
  246. { attributes specified in a previous call to FindFirst. The     }
  247. { search record must be one passed to FindFirst. Errors (and no }
  248. { more files) are reported in DosError.                         }
  249.  
  250. procedure FindNext(var F: TSearchRec);
  251.  
  252. { UnpackTime converts a 4-byte packed date/time returned by     }
  253. { FindFirst, FindNext or GetFTime into a TDateTime record.      }
  254.  
  255. procedure UnpackTime(P: Longint; var T: TDateTime);
  256.  
  257. { PackTime converts a TDateTime record into a 4-byte packed     }
  258. { date/time used by SetFTime.                                   }
  259.  
  260. procedure PackTime(var T: TDateTime; var P: Longint);
  261.  
  262. { GetIntVec returns the address stored in the specified         }
  263. { interrupt vector.                                             }
  264.  
  265. procedure GetIntVec(IntNo: Byte; var Vector: Pointer);
  266.  
  267. { SetIntVec sets the address in the interrupt vector table for  }
  268. { the specified interrupt.                                      }
  269.  
  270. procedure SetIntVec(IntNo: Byte; Vector: Pointer);
  271.  
  272. { FileSearch searches for the file given by Name in the list of }
  273. { directories given by List. The directory paths in List must   }
  274. { be separated by semicolons. The search always starts with the }
  275. { current directory of the current drive. If the file is found, }
  276. { FileSearch stores a concatenation of the directory path and   }
  277. { the file name in Dest. Otherwise FileSearch stores an empty   }
  278. { string in Dest. The maximum length of the result is defined   }
  279. { by the fsPathName constant. The returned value is Dest.       }
  280.  
  281. function FileSearch(Dest, Name, List: PChar): PChar;
  282.  
  283. { FileExpand fully expands the file name in Name, and stores    }
  284. { the result in Dest. The maximum length of the result is       }
  285. { defined by the fsPathName constant. The result is an all    }
  286. { upper case string consisting of a drive letter, a colon, a    }
  287. { root relative directory path, and a file name. Embedded '.'    }
  288. { and '..' directory references are removed, and all name and    }
  289. { extension components are truncated to 8 and 3 characters. The }
  290. { returned value is Dest.                            }
  291.  
  292. function FileExpand(Dest, Name: PChar): PChar;
  293.  
  294. { FileSplit splits the file name specified by Path into its     }
  295. { three components. Dir is set to the drive and directory path  }
  296. { with any leading and trailing backslashes, Name is set to the }
  297. { file name, and Ext is set to the extension with a preceding   }
  298. { period. If a component string parameter is NIL, the           }
  299. { corresponding part of the path is not stored. If the path     }
  300. { does not contain a given component, the returned component    }
  301. { string is empty. The maximum lengths of the strings returned  }
  302. { in Dir, Name, and Ext are defined by the fsDirectory,         }
  303. { fsFileName, and fsExtension constants. The returned value is  }
  304. { a combination of the fcDirectory, fcFileName, and fcExtension }
  305. { bit masks, indicating which components were present in the    }
  306. { path. If the name or extension contains any wildcard          }
  307. { characters (* or ?), the fcWildcards flag is set in the       }
  308. { returned value.                                               }
  309.  
  310. function FileSplit(Path, Dir, Name, Ext: PChar): Word;
  311.  
  312. { GetCurDir returns the current directory of a specified drive. }
  313. { Drive = 0 indicates the current drive, 1 indicates drive A, 2 }
  314. { indicates drive B, and so on. The string returned in Dir      }
  315. { always starts with a drive letter, a colon, and a backslash.  }
  316. { The maximum length of the resulting string is defined by the  }
  317. { fsDirectory constant. The returned value is Dir. Errors are   }
  318. { reported in DosError.                                         }
  319.  
  320. function GetCurDir(Dir: PChar; Drive: Byte): PChar;
  321.  
  322. { SetCurDir changes the current directory to the path specified }
  323. { by Dir. If Dir specifies a drive letter, the current drive is }
  324. { also changed. Errors are reported in DosError.                }
  325.  
  326. procedure SetCurDir(Dir: PChar);
  327.  
  328. { CreateDir creates a new subdirectory with the path specified  }
  329. { by Dir. Errors are reported in DosError.                      }
  330.  
  331. procedure CreateDir(Dir: PChar);
  332.  
  333. { RemoveDir removes the subdirectory with the path specified by }
  334. { Dir. Errors are reported in DosError.                         }
  335.  
  336. procedure RemoveDir(Dir: PChar);
  337.  
  338. { GetArgCount returns the number of parameters passed to the    }
  339. { program on the command line.                                  }
  340.  
  341. function GetArgCount: Integer;
  342.  
  343. { GetArgStr returns the Index'th parameter from the command     }
  344. { line, or an empty string if Index is less than zero or        }
  345. { greater than GetArgCount. If Index is zero, GetArgStr returns }
  346. { the filename of the current module. The maximum length of the }
  347. { string returned in Dest is given by the MaxLen parameter. The }
  348. { returned value is Dest.                                       }
  349.  
  350. function GetArgStr(Dest: PChar; Index: Integer; MaxLen: Word): PChar;
  351.  
  352. { GetEnvVar returns a pointer to the value of a specified       }
  353. { environment variable, i.e. a pointer to the first character   }
  354. { after the equals sign (=) in the environment entry given by   }
  355. { VarName. VarName is case insensitive. GetEnvVar returns NIL   }
  356. { if the specified environment variable does not exist.         }
  357.  
  358. function GetEnvVar(VarName: PChar): PChar;
  359.  
  360. implementation
  361.  
  362. {$IFDEF Windows}
  363. {$DEFINE ProtectedMode}
  364. {$ENDIF}
  365.  
  366. {$IFDEF DPMI}
  367. {$DEFINE ProtectedMode}
  368. {$ENDIF}
  369.  
  370. {$IFDEF Windows}
  371.  
  372. uses WinTypes, WinProcs, Strings;
  373.  
  374. {$ELSE}
  375.  
  376. uses Strings;
  377.  
  378. {$ENDIF}
  379.  
  380. {$IFDEF Windows}
  381.  
  382. procedure AnsiDosFunc; assembler;
  383. var
  384.   TempName: array[0..fsPathName] of Char;
  385. asm
  386.     PUSH    DS
  387.     PUSH    CX
  388.     PUSH    AX
  389.     MOV    SI,DI
  390.     PUSH    ES
  391.     POP    DS
  392.     LEA    DI,TempName
  393.     PUSH    SS
  394.     POP    ES
  395.     MOV    CX,fsPathName
  396.     CLD
  397. @@1:    LODSB
  398.     OR    AL,AL
  399.     JE    @@2
  400.     STOSB
  401.     LOOP    @@1
  402. @@2:    XOR    AL,AL
  403.     STOSB
  404.     LEA    DI,TempName
  405.     PUSH    SS
  406.     PUSH    DI
  407.     PUSH    SS
  408.     PUSH    DI
  409.     CALL    AnsiToOem
  410.     POP    AX
  411.     POP    CX
  412.     LEA    DX,TempName
  413.     PUSH    SS
  414.     POP    DS
  415.     INT    21H
  416.     POP    DS
  417. end;
  418.  
  419. {$ELSE}
  420.  
  421. procedure AnsiDosFunc; assembler;
  422. asm
  423.     PUSH    DS
  424.     MOV    DX,DI
  425.     PUSH    ES
  426.     POP    DS
  427.     INT    21H
  428.     POP    DS
  429. end;
  430.  
  431. {$ENDIF}
  432.  
  433. function DosVersion: Word; assembler;
  434. asm
  435.     MOV    AH,30H
  436.     INT    21H
  437. end;
  438.  
  439. procedure Intr(IntNo: Byte; var Regs: TRegisters); assembler;
  440. asm
  441.     PUSH    DS
  442. {$IFDEF ProtectedMode}
  443. {$IFDEF Windows}
  444.     PUSH    CS
  445.     CALL    AllocCSToDSAlias
  446. {$ELSE}
  447.     MOV    AX,CS
  448.     ADD    AX,SelectorInc
  449. {$ENDIF}
  450.     MOV    DS,AX
  451.     CLI
  452.     PUSH    WORD PTR DS:@@Int
  453.     PUSH    DS
  454.     MOV    AL,IntNo
  455.     MOV    BYTE PTR DS:@@Int+1,AL
  456. {$ELSE}
  457.     PUSH    WORD PTR CS:@@Int
  458.     MOV    AL,IntNo
  459.     MOV    BYTE PTR CS:@@Int+1,AL
  460. {$ENDIF}
  461.     LDS    SI,Regs
  462.     CLD
  463.     LODSW
  464.     PUSH    AX
  465.     LODSW
  466.     XCHG    AX,BX
  467.     LODSW
  468.     XCHG    AX,CX
  469.     LODSW
  470.     XCHG    AX,DX
  471.     LODSW
  472.     XCHG    AX,BP
  473.     LODSW
  474.     PUSH    AX
  475.     LODSW
  476.     XCHG    AX,DI
  477.     LODSW
  478.     PUSH    AX
  479.     LODSW
  480. {$IFDEF DPMI}
  481.         VERR    AX
  482.     JNZ    @@1
  483.     MOV    ES,AX
  484. @@1:    POP    AX
  485.     VERR    AX
  486.     JNZ    @@2
  487.     MOV    DS,AX
  488. @@2:
  489. {$ELSE}
  490.     MOV    ES,AX
  491.     POP    DS
  492. {$ENDIF}
  493.     POP    SI
  494.     POP    AX
  495. @@Int:    INT    0
  496.     STI
  497.     PUSHF
  498.     PUSH    ES
  499.     PUSH    DI
  500.     PUSH    BP
  501.     MOV    BP,SP
  502. {$IFDEF ProtectedMode}
  503.     LES    DI,Regs+14
  504. {$ELSE}
  505.     LES    DI,Regs+12
  506. {$ENDIF}
  507.     CLD
  508.     STOSW
  509.     XCHG    AX,BX
  510.     STOSW
  511.     XCHG    AX,CX
  512.     STOSW
  513.     XCHG    AX,DX
  514.     STOSW
  515.     POP    AX
  516.     STOSW
  517.     XCHG    AX,SI
  518.     STOSW
  519.     POP    AX
  520.     STOSW
  521.     MOV    AX,DS
  522.     STOSW
  523.     POP    AX
  524.     STOSW
  525.     POP    AX
  526.     STOSW
  527. {$IFDEF ProtectedMode}
  528.     POP    DS
  529.     POP    WORD PTR DS:@@Int
  530. {$ELSE}
  531.     POP    WORD PTR CS:@@Int
  532. {$ENDIF}
  533. {$IFDEF Windows}
  534.     MOV    AX,DS
  535.     POP    DS
  536.     PUSH    AX
  537.     CALL    FreeSelector
  538. {$ELSE}
  539.     POP    DS
  540. {$ENDIF}
  541. end;
  542.  
  543. procedure MsDos(var Regs: TRegisters);
  544. begin
  545.   Intr($21, Regs);
  546. end;
  547.  
  548. procedure GetDate(var Year, Month, Day, DayOfWeek: Word); assembler;
  549. asm
  550.     MOV    AH,2AH
  551.     INT    21H
  552.     XOR    AH,AH
  553.     LES    DI,DayOfWeek
  554.     STOSW
  555.     MOV    AL,DL
  556.     LES    DI,Day
  557.     STOSW
  558.     MOV    AL,DH
  559.     LES    DI,Month
  560.     STOSW
  561.     XCHG    AX,CX
  562.     LES    DI,Year
  563.     STOSW
  564. end;
  565.  
  566. procedure SetDate(Year, Month, Day: Word); assembler;
  567. asm
  568.     MOV    CX,Year
  569.     MOV    DH,BYTE PTR Month
  570.     MOV    DL,BYTE PTR Day
  571.     MOV    AH,2BH
  572.     INT    21H
  573. end;
  574.  
  575. procedure GetTime(var Hour, Minute, Second, Sec100: Word); assembler;
  576. asm
  577.     MOV    AH,2CH
  578.     INT    21H
  579.     XOR    AH,AH
  580.     MOV    AL,DL
  581.     LES    DI,Sec100
  582.     STOSW
  583.     MOV    AL,DH
  584.     LES    DI,Second
  585.     STOSW
  586.     MOV    AL,CL
  587.     LES    DI,Minute
  588.     STOSW
  589.     MOV    AL,CH
  590.     LES    DI,Hour
  591.     STOSW
  592. end;
  593.  
  594. procedure SetTime(Hour, Minute, Second, Sec100: Word); assembler;
  595. asm
  596.     MOV    CH,BYTE PTR Hour
  597.     MOV    CL,BYTE PTR Minute
  598.     MOV    DH,BYTE PTR Second
  599.     MOV    DL,BYTE PTR Sec100
  600.     MOV    AH,2DH
  601.     INT    21H
  602. end;
  603.  
  604. procedure GetCBreak(var Break: Boolean); assembler;
  605. asm
  606.     MOV    AX,3300H
  607.     INT    21H
  608.     LES    DI,Break
  609.     MOV    ES:[DI],DL
  610. end;
  611.  
  612. procedure SetCBreak(Break: Boolean); assembler;
  613. asm
  614.     MOV    DL,Break
  615.     MOV    AX,3301H
  616.     INT    21H
  617. end;
  618.  
  619. procedure GetVerify(var Verify: Boolean); assembler;
  620. asm
  621.     MOV    AH,54H
  622.     INT    21H
  623.     LES    DI,Verify
  624.     STOSB
  625. end;
  626.  
  627. procedure SetVerify(Verify: Boolean); assembler;
  628. asm
  629.     MOV    AL,Verify
  630.     MOV    AH,2EH
  631.     INT    21H
  632. end;
  633.  
  634. function DiskFree(Drive: Byte): Longint; assembler;
  635. asm
  636.     MOV    DL,Drive
  637.     MOV    AH,36H
  638.     INT    21H
  639.     MOV    DX,AX
  640.     CMP    AX,0FFFFH
  641.     JE    @@1
  642.     MUL    CX
  643.     MUL    BX
  644. @@1:
  645. end;
  646.  
  647. function DiskSize(Drive: Byte): Longint; assembler;
  648. asm
  649.     MOV    DL,Drive
  650.     MOV    AH,36H
  651.     INT    21H
  652.     MOV    BX,DX
  653.     MOV    DX,AX
  654.     CMP    AX,0FFFFH
  655.     JE    @@1
  656.     MUL    CX
  657.     MUL    BX
  658. @@1:
  659. end;
  660.  
  661. procedure GetFAttr(var F; var Attr: Word); assembler;
  662. asm
  663.     PUSH    DS
  664.     LDS    DX,F
  665.     ADD    DX,OFFSET TFileRec.Name
  666.     MOV    AX,4300H
  667.     INT    21H
  668.     POP    DS
  669.     JNC    @@1
  670.     XOR    CX,CX
  671.     JMP    @@2
  672. @@1:    XOR    AX,AX
  673. @@2:    MOV    DosError,AX
  674.     LES    DI,Attr
  675.     XCHG    AX,CX
  676.     STOSW
  677. end;
  678.  
  679. procedure SetFAttr(var F; Attr: Word); assembler;
  680. asm
  681.     PUSH    DS
  682.     LDS    DX,F
  683.     ADD    DX,OFFSET TFileRec.Name
  684.     MOV    CX,Attr
  685.     MOV    AX,4301H
  686.     INT    21H
  687.     POP    DS
  688.     JC    @@1
  689.     XOR    AX,AX
  690. @@1:    MOV    DosError,AX
  691. end;
  692.  
  693. procedure GetFTime(var F; var Time: Longint); assembler;
  694. asm
  695.     LES    DI,F
  696.     MOV    BX,ES:[DI].TFileRec.Handle
  697.     MOV    AX,5700H
  698.     INT    21H
  699.     JNC    @@1
  700.     XOR    CX,CX
  701.     XOR    DX,DX
  702.     JMP    @@2
  703. @@1:    XOR    AX,AX
  704. @@2:    MOV    DosError,AX
  705.     LES    DI,Time
  706.     CLD
  707.     XCHG    AX,CX
  708.     STOSW
  709.     XCHG    AX,DX
  710.     STOSW
  711. end;
  712.  
  713. procedure SetFTime(var F; Time: Longint); assembler;
  714. asm
  715.     LES    DI,F
  716.     MOV    BX,ES:[DI].TFileRec.Handle
  717.     MOV    CX,WORD PTR Time[0]
  718.     MOV    DX,WORD PTR Time[2]
  719.     MOV    AX,5701H
  720.     INT    21H
  721.     JC    @@1
  722.     XOR    AX,AX
  723. @@1:    MOV    DosError,AX
  724. end;
  725.  
  726. procedure FindFirst(Path: PChar; Attr: Word; var F: TSearchRec); assembler;
  727. asm
  728.     PUSH    DS
  729.     LDS    DX,F
  730.     MOV    AH,1AH
  731.     INT    21H
  732.     POP    DS
  733.     LES    DI,Path
  734.     MOV    CX,Attr
  735.     MOV    AH,4EH
  736.     CALL    AnsiDosFunc
  737.     JC    @@1
  738. {$IFDEF Windows}
  739.     LES    DI,F
  740.     ADD    DI,OFFSET TSearchRec.Name
  741.     PUSH    ES
  742.     PUSH    DI
  743.     PUSH    ES
  744.     PUSH    DI
  745.     CALL    OemToAnsi
  746. {$ENDIF}
  747.     XOR    AX,AX
  748. @@1:    MOV    DosError,AX
  749. end;
  750.  
  751. procedure FindNext(var F: TSearchRec); assembler;
  752. asm
  753.     PUSH    DS
  754.     LDS    DX,F
  755.     MOV    AH,1AH
  756.     INT    21H
  757.     POP    DS
  758.     MOV    AH,4FH
  759.     INT    21H
  760.     JC    @@1
  761. {$IFDEF Windows}
  762.     LES    DI,F
  763.     ADD    DI,OFFSET TSearchRec.Name
  764.     PUSH    ES
  765.     PUSH    DI
  766.     PUSH    ES
  767.     PUSH    DI
  768.     CALL    OemToAnsi
  769. {$ENDIF}
  770.     XOR    AX,AX
  771. @@1:    MOV    DosError,AX
  772. end;
  773.  
  774. procedure UnpackTime(P: Longint; var T: TDateTime); assembler;
  775. asm
  776.     LES    DI,T
  777.     CLD
  778.     MOV    AX,P.Word[2]
  779.     MOV    CL,9
  780.     SHR    AX,CL
  781.     ADD    AX,1980
  782.     STOSW
  783.     MOV    AX,P.Word[2]
  784.     MOV    CL,5
  785.     SHR    AX,CL
  786.     AND    AX,15
  787.     STOSW
  788.     MOV    AX,P.Word[2]
  789.     AND    AX,31
  790.     STOSW
  791.     MOV    AX,P.Word[0]
  792.     MOV    CL,11
  793.     SHR    AX,CL
  794.     STOSW
  795.     MOV    AX,P.Word[0]
  796.     MOV    CL,5
  797.     SHR    AX,CL
  798.     AND    AX,63
  799.     STOSW
  800.     MOV    AX,P.Word[0]
  801.     AND    AX,31
  802.     SHL    AX,1
  803.     STOSW
  804. end;
  805.  
  806. procedure PackTime(var T: TDateTime; var P: Longint); assembler;
  807. asm
  808.     PUSH    DS
  809.     LDS    SI,T
  810.     CLD
  811.     LODSW
  812.     SUB    AX,1980
  813.     MOV    CL,9
  814.     SHL    AX,CL
  815.     XCHG    AX,DX
  816.     LODSW
  817.     MOV    CL,5
  818.     SHL    AX,CL
  819.     ADD    DX,AX
  820.     LODSW
  821.     ADD    DX,AX
  822.     LODSW
  823.     MOV    CL,11
  824.     SHL    AX,CL
  825.     XCHG    AX,BX
  826.     LODSW
  827.     MOV    CL,5
  828.     SHL    AX,CL
  829.     ADD    BX,AX
  830.     LODSW
  831.     SHR    AX,1
  832.     ADD    AX,BX
  833.     POP    DS
  834.     LES    DI,P
  835.     STOSW
  836.     XCHG    AX,DX
  837.     STOSW
  838. end;
  839.  
  840. procedure GetIntVec(IntNo: Byte; var Vector: Pointer); assembler;
  841. asm
  842.     MOV    AL,IntNo
  843.     MOV    AH,35H
  844.     INT    21H
  845.     MOV    AX,ES
  846.     LES    DI,Vector
  847.     CLD
  848.     XCHG    AX,BX
  849.     STOSW
  850.     XCHG    AX,BX
  851.     STOSW
  852. end;
  853.  
  854. procedure SetIntVec(IntNo: Byte; Vector: Pointer); assembler;
  855. asm
  856.     PUSH    DS
  857.     LDS    DX,Vector
  858.     MOV    AL,IntNo
  859.     MOV    AH,25H
  860.     INT    21H
  861.     POP    DS
  862. end;
  863.  
  864. function FileSearch(Dest, Name, List: PChar): PChar; assembler;
  865. asm
  866.     PUSH    DS
  867.     CLD
  868.     LDS    SI,List
  869.     LES    DI,Dest
  870.     MOV    CX,fsPathName
  871. @@1:    PUSH    DS
  872.     PUSH    SI
  873.     JCXZ    @@3
  874.     LDS    SI,Name
  875. @@2:    LODSB
  876.     OR    AL,AL
  877.     JE    @@3
  878.     STOSB
  879.     LOOP    @@2
  880. @@3:    XOR    AL,AL
  881.     STOSB
  882.     LES    DI,Dest
  883.     MOV    AX,4300H
  884.     CALL    AnsiDosFunc
  885.     POP    SI
  886.     POP    DS
  887.     JC    @@4
  888.     TEST    CX,18H
  889.     JE    @@9
  890. @@4:    LES    DI,Dest
  891.     MOV    CX,fsPathName
  892.     XOR    AH,AH
  893.     LODSB
  894.     OR    AL,AL
  895.     JE    @@8
  896. @@5:    CMP    AL,';'
  897.     JE    @@7
  898.     JCXZ    @@6
  899.     MOV    AH,AL
  900.     STOSB
  901.     DEC    CX
  902. @@6:    LODSB
  903.     OR    AL,AL
  904.     JNE    @@5
  905.     DEC    SI
  906. @@7:    JCXZ    @@1
  907.     CMP    AH,':'
  908.     JE    @@1
  909.     MOV    AL,'\'
  910.     CMP    AL,AH
  911.         JE    @@1
  912.     STOSB
  913.     DEC    CX
  914.     JMP    @@1
  915. @@8:    STOSB
  916. @@9:    MOV    AX,Dest.Word[0]
  917.     MOV    DX,Dest.Word[2]
  918.     POP    DS
  919. end;
  920.  
  921. function FileExpand(Dest, Name: PChar): PChar; assembler;
  922. var
  923.   TempName: array[0..159] of Char;
  924. asm
  925.     PUSH    DS
  926.     CLD
  927.     LDS    SI,Name
  928.     LEA    DI,TempName
  929.     PUSH    SS
  930.     POP    ES
  931.     LODSW
  932.     OR    AL,AL
  933.     JE    @@1
  934.     CMP    AH,':'
  935.     JNE    @@1
  936.     CMP    AL,'a'
  937.     JB    @@2
  938.     CMP    AL,'z'
  939.     JA    @@2
  940.     SUB    AL,20H
  941.     JMP    @@2
  942. @@1:    DEC    SI
  943.     DEC    SI
  944.     MOV    AH,19H
  945.     INT    21H
  946.     ADD    AL,'A'
  947.     MOV    AH,':'
  948. @@2:    STOSW
  949.     CMP    [SI].Byte,'\'
  950.     JE    @@3
  951.     SUB    AL,'A'-1
  952.     MOV    DL,AL
  953.     MOV    AL,'\'
  954.     STOSB
  955.     PUSH    DS
  956.     PUSH    SI
  957.     MOV    AH,47H
  958.     MOV    SI,DI
  959.     PUSH    ES
  960.     POP    DS
  961.     INT    21H
  962.     POP    SI
  963.     POP    DS
  964.     JC    @@3
  965.     XOR    AL,AL
  966.     CMP    AL,ES:[DI]
  967.     JE    @@3
  968. {$IFDEF Windows}
  969.     PUSH    ES
  970.     PUSH    ES
  971.     PUSH    DI
  972.     PUSH    ES
  973.     PUSH    DI
  974.     CALL    OemToAnsi
  975.     POP    ES
  976. {$ENDIF}
  977.     MOV    CX,0FFFFH
  978.     XOR    AL,AL
  979.     CLD
  980.     REPNE    SCASB
  981.     DEC    DI
  982.     MOV    AL,'\'
  983.     STOSB
  984. @@3:    MOV    CX,8
  985. @@4:    LODSB
  986.     OR    AL,AL
  987.     JE    @@7
  988.     CMP    AL,'\'
  989.     JE    @@7
  990.     CMP    AL,'.'
  991.     JE    @@6
  992.     JCXZ    @@4
  993.     DEC    CX
  994. {$IFNDEF Windows}
  995.     CMP    AL,'a'
  996.     JB    @@5
  997.     CMP    AL,'z'
  998.     JA    @@5
  999.     SUB    AL,20H
  1000. {$ENDIF}
  1001. @@5:    STOSB
  1002.     JMP    @@4
  1003. @@6:    MOV    CL,3
  1004.     JMP    @@5
  1005. @@7:    CMP    ES:[DI-2].Word,'.\'
  1006.     JNE    @@8
  1007.     DEC    DI
  1008.     DEC    DI
  1009.     JMP    @@10
  1010. @@8:    CMP    ES:[DI-2].Word,'..'
  1011.     JNE    @@10
  1012.     CMP    ES:[DI-3].Byte,'\'
  1013.     JNE    @@10
  1014.     SUB    DI,3
  1015.     CMP    ES:[DI-1].Byte,':'
  1016.     JE    @@10
  1017. @@9:    DEC    DI
  1018.     CMP    ES:[DI].Byte,'\'
  1019.     JNE    @@9
  1020. @@10:    MOV    CL,8
  1021.     OR    AL,AL
  1022.     JNE    @@5
  1023.     CMP    ES:[DI-1].Byte,':'
  1024.     JNE    @@11
  1025.     MOV    AL,'\'
  1026.     STOSB
  1027. @@11:    LEA    SI,TempName
  1028.     PUSH    SS
  1029.     POP    DS
  1030.     MOV    CX,DI
  1031.     SUB    CX,SI
  1032.     CMP    CX,79
  1033.     JBE    @@12
  1034.     MOV    CX,79
  1035. @@12:    LES    DI,Dest
  1036.     PUSH    ES
  1037.     PUSH    DI
  1038. {$IFDEF Windows}
  1039.     PUSH    ES
  1040.     PUSH    DI
  1041. {$ENDIF}
  1042.     REP    MOVSB
  1043.     XOR    AL,AL
  1044.     STOSB
  1045. {$IFDEF Windows}
  1046.     CALL    AnsiUpper
  1047. {$ENDIF}
  1048.     POP    AX
  1049.     POP    DX
  1050.     POP    DS
  1051. end;
  1052.  
  1053. {$W+}
  1054.  
  1055. function FileSplit(Path, Dir, Name, Ext: PChar): Word;
  1056. var
  1057.   DirLen, NameLen, Flags: Word;
  1058.   NamePtr, ExtPtr: PChar;
  1059. begin
  1060.   NamePtr := StrRScan(Path, '\');
  1061.   if NamePtr = nil then NamePtr := StrRScan(Path, ':');
  1062.   if NamePtr = nil then NamePtr := Path else Inc(NamePtr);
  1063.   ExtPtr := StrScan(NamePtr, '.');
  1064.   if ExtPtr = nil then ExtPtr := StrEnd(NamePtr);
  1065.   DirLen := NamePtr - Path;
  1066.   if DirLen > fsDirectory then DirLen := fsDirectory;
  1067.   NameLen := ExtPtr - NamePtr;
  1068.   if NameLen > fsFilename then NameLen := fsFilename;
  1069.   Flags := 0;
  1070.   if (StrScan(NamePtr, '?') <> nil) or (StrScan(NamePtr, '*') <> nil) then
  1071.     Flags := fcWildcards;
  1072.   if DirLen <> 0 then Flags := Flags or fcDirectory;
  1073.   if NameLen <> 0 then Flags := Flags or fcFilename;
  1074.   if ExtPtr[0] <> #0 then Flags := Flags or fcExtension;
  1075.   if Dir <> nil then StrLCopy(Dir, Path, DirLen);
  1076.   if Name <> nil then StrLCopy(Name, NamePtr, NameLen);
  1077.   if Ext <> nil then StrLCopy(Ext, ExtPtr, fsExtension);
  1078.   FileSplit := Flags;
  1079. end;
  1080.  
  1081. {$W-}
  1082.  
  1083. function GetCurDir(Dir: PChar; Drive: Byte): PChar; assembler;
  1084. asm
  1085.     MOV    AL,Drive
  1086.     OR    AL,AL
  1087.     JNE    @@1
  1088.     MOV    AH,19H
  1089.     INT    21H
  1090.     INC    AX
  1091. @@1:    MOV    DL,AL
  1092.     LES    DI,Dir
  1093.     PUSH    ES
  1094.     PUSH    DI
  1095.     CLD
  1096.     ADD    AL,'A'-1
  1097.     MOV    AH,':'
  1098.     STOSW
  1099.     MOV    AX,'\'
  1100.     STOSW
  1101.     PUSH    DS
  1102.     LEA    SI,[DI-1]
  1103.     PUSH    ES
  1104.     POP    DS
  1105.     MOV    AH,47H
  1106.     INT    21H
  1107.     JC    @@2
  1108. {$IFDEF Windows}
  1109.     PUSH    DS
  1110.     PUSH    SI
  1111.     PUSH    DS
  1112.     PUSH    SI
  1113.     CALL    OemToAnsi
  1114. {$ENDIF}
  1115.     XOR    AX,AX
  1116. @@2:    POP    DS
  1117.     MOV    DosError,AX
  1118.     POP    AX
  1119.     POP    DX
  1120. end;
  1121.  
  1122. procedure SetCurDir(Dir: PChar); assembler;
  1123. asm
  1124.     LES    DI,Dir
  1125.     MOV    AX,ES:[DI]
  1126.     OR    AL,AL
  1127.     JE    @@2
  1128.     CMP    AH,':'
  1129.     JNE    @@1
  1130.     AND    AL,0DFH
  1131.     SUB    AL,'A'
  1132.     MOV    DL,AL
  1133.     MOV    AH,0EH
  1134.     INT    21H
  1135.     MOV    AH,19H
  1136.     INT    21H
  1137.     CMP    AL,DL
  1138.     MOV    AX,15
  1139.     JNE    @@3
  1140.     CMP    AH,ES:[DI+2]
  1141.     JE    @@2
  1142. @@1:    MOV    AH,3BH
  1143.     CALL    AnsiDosFunc
  1144.     JC    @@3
  1145. @@2:    XOR    AX,AX
  1146. @@3:    MOV    DosError,AX
  1147. end;
  1148.  
  1149. procedure CreateDir(Dir: PChar); assembler;
  1150. asm
  1151.     LES    DI,Dir
  1152.     MOV    AH,39H
  1153.     CALL    AnsiDosFunc
  1154.     JC    @@1
  1155.     XOR    AX,AX
  1156. @@1:    MOV    DosError,AX
  1157. end;
  1158.  
  1159. procedure RemoveDir(Dir: PChar); assembler;
  1160. asm
  1161.     LES    DI,Dir
  1162.     MOV    AH,3AH
  1163.     CALL    AnsiDosFunc
  1164.     JC    @@1
  1165.     XOR    AX,AX
  1166. @@1:    MOV    DosError,AX
  1167. end;
  1168.  
  1169. {$IFDEF Windows}
  1170.  
  1171. procedure ArgStrCount; assembler;
  1172. asm
  1173.     LDS    SI,CmdLine
  1174.     CLD
  1175. @@1:    LODSB
  1176.     OR    AL,AL
  1177.     JE    @@2
  1178.     CMP    AL,' '
  1179.     JBE    @@1
  1180. @@2:    DEC    SI
  1181.     MOV    BX,SI
  1182. @@3:    LODSB
  1183.     CMP    AL,' '
  1184.     JA    @@3
  1185.     DEC    SI
  1186.     MOV    AX,SI
  1187.     SUB    AX,BX
  1188.     JE    @@4
  1189.     LOOP    @@1
  1190. @@4:
  1191. end;
  1192.  
  1193. function GetArgCount: Integer; assembler;
  1194. asm
  1195.     PUSH    DS
  1196.     XOR    CX,CX
  1197.     CALL    ArgStrCount
  1198.     XCHG    AX,CX
  1199.     NEG    AX
  1200.     POP    DS
  1201. end;
  1202.  
  1203. function GetArgStr(Dest: PChar; Index: Integer;
  1204.   MaxLen: Word): PChar; assembler;
  1205. asm
  1206.     MOV    CX,Index
  1207.     JCXZ    @@2
  1208.     PUSH    DS
  1209.     CALL    ArgStrCount
  1210.     MOV    SI,BX
  1211.     LES    DI,Dest
  1212.     MOV    CX,MaxLen
  1213.     CMP    CX,AX
  1214.     JB    @@1
  1215.     XCHG    AX,CX
  1216. @@1:    REP    MOVSB
  1217.     XCHG    AX,CX
  1218.     STOSB
  1219.     POP    DS
  1220.     JMP    @@3
  1221. @@2:    PUSH    HInstance
  1222.     PUSH    Dest.Word[2]
  1223.     PUSH    Dest.Word[0]
  1224.     MOV    AX,MaxLen
  1225.     INC    AX
  1226.     PUSH    AX
  1227.     CALL    GetModuleFileName
  1228. @@3:    MOV    AX,Dest.Word[0]
  1229.     MOV    DX,Dest.Word[2]
  1230. end;
  1231.  
  1232. {$ELSE}
  1233.  
  1234. procedure ArgStrCount; assembler;
  1235. asm
  1236.     MOV    DS,PrefixSeg
  1237.     MOV    SI,80H
  1238.     CLD
  1239.     LODSB
  1240.     MOV    DL,AL
  1241.     XOR    DH,DH
  1242.     ADD    DX,SI
  1243. @@1:    CMP    SI,DX
  1244.     JE    @@2
  1245.     LODSB
  1246.     CMP    AL,' '
  1247.     JBE    @@1
  1248.     DEC    SI
  1249. @@2:    MOV    BX,SI
  1250. @@3:    CMP    SI,DX
  1251.     JE    @@4
  1252.     LODSB
  1253.     CMP    AL,' '
  1254.     JA    @@3
  1255.     DEC    SI
  1256. @@4:    MOV    AX,SI
  1257.     SUB    AX,BX
  1258.     JE    @@5
  1259.     LOOP    @@1
  1260. @@5:
  1261. end;
  1262.  
  1263. function GetArgCount: Integer; assembler;
  1264. asm
  1265.     PUSH    DS
  1266.     XOR    CX,CX
  1267.     CALL    ArgStrCount
  1268.     XCHG    AX,CX
  1269.     NEG    AX
  1270.     POP    DS
  1271. end;
  1272.  
  1273. function GetArgStr(Dest: PChar; Index: Integer;
  1274.   MaxLen: Word): PChar; assembler;
  1275. asm
  1276.     PUSH    DS
  1277.     MOV    CX,Index
  1278.     JCXZ    @@1
  1279.     CALL    ArgStrCount
  1280.     MOV    SI,BX
  1281.     JMP    @@4
  1282. @@1:    MOV    AH,30H
  1283.     INT    21H
  1284.     CMP    AL,3
  1285.     MOV    AX,0
  1286.     JB    @@4
  1287.     MOV    DS,PrefixSeg
  1288.     MOV    ES,DS:WORD PTR 2CH
  1289.     XOR    DI,DI
  1290.     CLD
  1291. @@2:    CMP    AL,ES:[DI]
  1292.     JE    @@3
  1293.     MOV    CX,-1
  1294.     REPNE    SCASB
  1295.     JMP    @@2
  1296. @@3:    ADD    DI,3
  1297.     MOV    SI,DI
  1298.     PUSH    ES
  1299.     POP    DS
  1300.     MOV    CX,256
  1301.     REPNE    SCASB
  1302.     XCHG    AX,CX
  1303.     NOT    AL
  1304. @@4:    LES    DI,Dest
  1305.     MOV    CX,MaxLen
  1306.     CMP    CX,AX
  1307.     JB    @@5
  1308.     XCHG    AX,CX
  1309. @@5:    REP    MOVSB
  1310.     XCHG    AX,CX
  1311.     STOSB
  1312.     MOV    AX,Dest.Word[0]
  1313.     MOV    DX,Dest.Word[2]
  1314.     POP    DS
  1315. end;
  1316.  
  1317. {$ENDIF}
  1318.  
  1319. {$W+}
  1320.  
  1321. function GetEnvVar(VarName: PChar): PChar;
  1322. var
  1323.   L: Word;
  1324.   P: PChar;
  1325. begin
  1326.   L := StrLen(VarName);
  1327. {$IFDEF Windows}
  1328.   P := GetDosEnvironment;
  1329. {$ELSE}
  1330.   P := Ptr(Word(Ptr(PrefixSeg, $2C)^), 0);
  1331. {$ENDIF}
  1332.   while P^ <> #0 do
  1333.   begin
  1334.     if (StrLIComp(P, VarName, L) = 0) and (P[L] = '=') then
  1335.     begin
  1336.       GetEnvVar := P + L + 1;
  1337.       Exit;
  1338.     end;
  1339.     Inc(P, StrLen(P) + 1);
  1340.   end;
  1341.   GetEnvVar := nil;
  1342. end;
  1343.  
  1344. {$W-}
  1345.  
  1346. end.
  1347.